(in-package :experiment)

(defclass sync-nback (nback)
  ((input-mode :type (member :mouse :keypad) :initarg :input-mode)
   (pulse-interval :initarg :pulse-interval :initform 2)
   (fuzziness :initarg :fuzziness :initform 1)
   (start-time)
   (final-sync :initform nil)
   (next-sync :initform nil))
  (:default-initargs
   :iterations 9))

(defmethod state-dump append (exp (state sync-nback))
  (declare (ignore exp))
  (with-slots (input-mode pulse-interval fuzziness) state
    (list :input-mode input-mode
          :pulse-interval pulse-interval
          :fuzziness fuzziness)))

(defun sync-nback-submit-view (experiment state)
  (with-slots (input-mode) state
    (ecase input-mode
      (:mouse
       (make-instance 'gwee:button
                      :data "Match!"
                      :width 150
                      :height 50
                      :font (gwee:open-font gwee:*default-font-name* 24)
                      :click-callback (lambda (b)
                                        (declare (ignore b))
                                        (state-dispatch-event experiment state
                                                              (make-instance 'click-event :source :match)))))
      (:keypad
       (make-instance 'gwee:text-area
                      :data "press enter to match"
                      :height 50
                      :font (gwee:open-font gwee:*default-font-name* 18))))))

(defmethod state-init (experiment (state sync-nback))
  (log experiment 'start :iterations (nback-iterations state))
  (with-slots (start-time) state
    (setf start-time (get-internal-real-time)
          (nback-letters state)
          (list (nth (random (length (nback-pool state))) (nback-pool state)))
          (nback-letter-view state)
          (make-instance 'gwee:text-area
                         :vertical-justification :center :horizontal-justification :center
                         :data (string (car (nback-letters state)))
                         :width 50 :height 45
                         :wrap-p nil
                         :font (gwee:open-font gwee:*default-font-name* 48)))
    (log experiment 'letter :letter (first (nback-letters state)))
    (make-instance 'gwee:column-layout
                   :padding 10
                   :parent state
                   :width (gwee:view-width state)
                   :height (gwee:view-height state)
                   :subviews (list
                              (nback-letter-view state)
                              (sync-nback-submit-view experiment state)))
    (start-timer (nback-on-delay state))))

;; (defun sync-nback-within-fuzziness-p (state)
;;   (with-slots (fuzziness) state
;;     (<= (- (nback-iterations state) (length (nback-letters state)))
;;         fuzziness)))

(define-action sync-pulse ((state sync-nback)
                           (keypress :char #\^))
  (with-slots (start-time next-sync pulse-interval fuzziness final-sync) state
    (let* ((now (get-internal-real-time))
           (finished-at (+ start-time (* (nback-iterations state)
                                         (+ (nback-on-delay state)
                                            (nback-off-delay state))
                                         internal-time-units-per-second))))
      (if (or (and final-sync (< final-sync now))
              (> now (+ finished-at
                        (* fuzziness
                           internal-time-units-per-second))))
          (state-onward *experiment* state)
          (let* ((remaining (- finished-at now))
                 (earliest-sync (+ now (* (floor remaining
                                                 (* pulse-interval internal-time-units-per-second))
                                          pulse-interval
                                          internal-time-units-per-second)))
                 (latest-sync (+ earliest-sync (* pulse-interval internal-time-units-per-second))))
            ;; (print (list 'pulse :now now :start-time start-time :finished finished-at :remaining remaining :earliest earliest-sync :latest latest-sync :fuzzy-ms (* fuzziness
            ;;                                                                                                                                                         (+ (nback-on-delay state)
            ;;                                                                                                                                                            (nback-off-delay state))
            ;;                                                                                                                                                         internal-time-units-per-second)))
            (if (<= (- finished-at (* fuzziness
                                      (+ (nback-on-delay state)
                                         (nback-off-delay state))
                                      internal-time-units-per-second))
                    earliest-sync)
                (setf final-sync earliest-sync)
                (setf final-sync latest-sync))
            (setf next-sync (+ now
                               (* pulse-interval internal-time-units-per-second)))
            (lg 'sync-pulse :finished-at finished-at :final-sync final-sync))))))

  ;;(< (length (nback-letters state)) (nback-iterations state))
  ;; (with-slots (start-time max-scale) state
  ;;   (let* ((now (get-internal-real-time))
  ;;          (total-time (* (nback-iterations state)
  ;;                         (+ (nback-on-delay state)
  ;;                            (nback-off-delay state))
  ;;                         internal-time-units-per-second))
  ;;          (remaining (- total-time (- now start-time)))
  ;;          (finished-at (+ start-time total-time))
  ;;          (earliest-sync (+ now
  ;;                            (* (floor remaining (* 2 internal-time-units-per-second))
  ;;                               internal-time-units-per-second)))
  ;;          (latest-sync (+ earliest-sync (* 2 internal-time-units-per-second))))
  ;;     (if (< (- finished-at earliest-sync)
  ;;            (- latest-sync finished-at))
  ;;         ;; closer to earliest-sync

(define-action next-state ((state sync-nback)
                           (timeout))
  (with-slots (final-sync) state
    (let ((now (get-internal-real-time)))
      (if (and
           final-sync
           (< final-sync
              (+ now (* (ecase (nback-state state)
                          (:on (nback-off-delay state))
                          (:off (nback-on-delay state)))
                        internal-time-units-per-second))))
          (setf (gwee:view-data (nback-letter-view state)) "")
          (ecase (nback-state state)
            (:on
             (setf (nback-state state) :off
                   (gwee:view-data (nback-letter-view state)) "")
             (start-timer (nback-off-delay state)))
            (:off
             ;; 2/3 chance it changes
             (let ((ch (if (or (< (length (nback-letters state)) (nback-n state))
                               (nback-match-p state)
                               (< (random 9) 6))
                           (nth (random (length (nback-pool state))) (nback-pool state))
                           (nth (1- (nback-n state)) (nback-letters state)))))
               (push ch (nback-letters state))
               (log *experiment* 'letter :letter ch)
               ;; (format t "letters: ~s~%" (nback-letters state))
               (setf (nback-state state) :on
                     (gwee:view-data (nback-letter-view state)) (string ch))
               (start-timer (nback-on-delay state)))))))))

(define-state-match mouse-mode ((state sync-nback))
  (with-slots (input-mode) state
    (eq input-mode :mouse)))

(define-state-match keypad-mode ((state sync-nback))
  (with-slots (input-mode) state
    (eq input-mode :keypad)))

(define-action mouse-match ((state sync-nback)
                            (click :source :match)
                            (mouse-mode))
  (log *experiment* 'match))

(define-action keypad-match ((state sync-nback)
                             (keypress :char #\Return)
                             (keypad-mode))
  (log *experiment* 'match))
